home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / asm / pc370_3.exe / lha / DEMOHATS.ALC < prev    next >
Text File  |  1986-07-21  |  7KB  |  197 lines
  1.     TITLE 'HATGIRL2.ALC - CALCULATE VALUE OF E FOR N HATS'
  2. *  PGMID.  HATGIRL2.ALC
  3. *  AUTHOR. DON HIGGINS.
  4. *          6365 - 32 AVENUE NORTH
  5. *          ST. PETERSBURG, FL 33710
  6. *
  7. *  DATE.    09/07/85.
  8. *  REMARKS. THIS PROGRAM CALCULATES VALUE OF E (BASE OF NATUARAL
  9. *           LOGRITHMS) USING THE CARELESS HAT CHECK GIRL ALGORITHM
  10. *           DESCRIBED BY ROBERT T. KUROSAKA IN 9/85 BYTE.  HE
  11. *           SHOWS THAT E IS EQUAL TO N! DIVIDED BY THE NUMBER OF
  12. *           WAYS THAT N HATS CAN BE DISTRIBUTED SUCH THAT NO ONE
  13. *           GETS THE CORRECT HAT.
  14. *
  15. *           THIS ALGORITHM IS WRITTEN IN IBM 370 ASSEMBLER TO BE
  16. *           RUN ON AN IBM PC USING THE PC/370 ASSEMBLER AND
  17. *           EMULATOR.  THIS PROGRAM DIFFERS FROM THE BASIC PROGRAM
  18. *           SHOWN IN BYTE, IN THAT IT IS DETERMINISTIC RATHER THAN
  19. *           USING A RANDOM SAMPLE OF DISTRIBUTIONS TO APPROXIMATE
  20. *           THE ANSWER FOR A GIVEN N.  THIS PROGRAM CALCULATES THE
  21. *           EXACT ANSWER FOR A GIVEN N.  THE LARGER THE VALUE OF N,
  22. *           THE MORE ACCURATE THE ANSWER IS.
  23. *
  24. HATGIRL2 CSECT
  25.     LR    BASE,ENTRY
  26.     USING HATGIRL2,BASE
  27.     LA    N,2
  28.     LA    ONE,1
  29.     LA    BADCOMB,0
  30.     L     ENTRY,=V(TIMER)
  31.     BALR  LINK,ENTRY      SAVE STARTING TIME IN 100TH SECONDS
  32.     ST    R0,TIME
  33. MAINLOOP EQU   *
  34.     BAL   LINK,CALCBAD    COUNT BAD COMBINATIONS FOR CURRENT N
  35.     BAL   LINK,CALCE      CALCULATE N! AND E FOR CURRENT N
  36.     L     ENTRY,=V(TIMER)
  37.     BALR  LINK,ENTRY
  38.     L     R1,TIME
  39.     ST    R0,TIME         SAVE NEW TIME
  40.     SR    R0,R1
  41.     CVD   R0,PWORK
  42.     MVC   DS,DSMASK
  43.     ED    DS,PWORK+4      EDIT SECONDS
  44.     LA    R2,MSGLINE
  45.     SVC   WTO             DISPLAY RESULTS FOR CURRENT N
  46.     AR    N,ONE
  47.     CH    N,=AL2(MAXN)
  48.     BNH   MAINLOOP
  49.     SVC   EXIT
  50.     TITLE 'CALCBAD - CALCULATE NUMBER OF BAD COMBINATIONS FOR N'
  51. CALCBAD  EQU   *              CALCULATE BADCOMB = TOTAL BAD COMBINATIONS
  52. *
  53. *  INCREMENT COMBINATION COUNTER D(N) TO NEXT BAD COMBINATION
  54. *  INCREMENT BADCOMB
  55. *  EXIT WHEN COUNTER OVERFLOWS
  56. *
  57.     XR    BADCOMB,BADCOMB
  58.     MVC   D,DINIT
  59.     MVC   DP,DPINIT
  60.     LA    I,1
  61.     XR    R1,R1
  62.     XR    R2,R2
  63.     LR    NM1,N
  64.     BCTR  NM1,0         SET NM1 = N - 1
  65. INCDI    EQU   *             INCREMENT D(I) TO NEXT BAD DIGIT
  66.     IC    J,D-1(I)
  67. FINDD    EQU   *             SEARCH DP(J) TO DP(N) FOR NEXT DIGIT
  68.     AR    J,ONE
  69.     CLR   J,N
  70.     BH    NOTFOUND      NO BAD DIGITS FOUND, GO INCR PREV DIGIT
  71.     IC    R1,DP-1(J)
  72.     CLR   I,R1          IS NEXT HIGHEST DIGIT AVAILABLE
  73.     BNL   FINDD         NO, GO TO NEXT LARGER DIGIT
  74.     CLR   J,I           IS NEXT DIGIT BAD
  75.     BE    FINDD         NO, GO TO NEXT LARGER DIGIT
  76. FOUND    EQU   *             SWAP LARGER DIGIT WITH D(I)
  77.     IC    R1,D-1(I)     SAVE OLD DIGIT
  78.     IC    R2,DP-1(J)    SAVE OLD POSITION OF NEW DIGIT
  79.     STC   J,D-1(I)      STORE NEW DIGIT
  80.     STC   I,DP-1(J)     SET POSITION OF NEW DIGIT
  81.     STC   R1,D-1(R2)    STORE OLD DIGIT
  82.     STC   R2,DP-1(R1)   SET POSITION OF OLD DIGIT
  83. SORT     EQU   *
  84. *
  85. *    SORT D(I+1) TO D(N) IN ASCENDING ORDER
  86. *
  87.     XR    J,J
  88.     LR    K,I
  89. NEXTDK   EQU   *             SEARCH DP(J) FOR NEXT DIGIT FOR D(K)
  90.     AR    K,ONE
  91.     CLR   K,N
  92.     BNL   CHKLAST       GO CHECK IF LAST SORTED DIGIT D(N) IS BAD
  93. NEXTDPJ  EQU   *             FIND NEXT HIGHEST DIGIT FOR D(K)
  94.     AR    J,ONE
  95.     IC    R1,DP-1(J)
  96.     CLR   K,R1          IS THIS DIGIT AVAILABLE
  97.     BH    NEXTDPJ
  98.     BE    CHKDIGIT      IF ALREADY AT K, SKIP SWAP
  99.     IC    R1,D-1(K)     SAVE OLD DIGIT
  100.     IC    R2,DP-1(J)    SAVE OLD POSITION OF NEW DIGIT
  101.     STC   J,D-1(K)      STORE NEW DIGIT
  102.     STC   K,DP-1(J)     SET POSITION OF NEW DIGIT
  103.     STC   R1,D-1(R2)    STORE OLD DIGIT
  104.     STC   R2,DP-1(R1)   SET POSITION OF OLD DIGIT
  105. CHKDIGIT EQU   *
  106.     CLR   J,K           IS SORT DIGIT BAD
  107.     BNE   NEXTDK        YES, CONTINUE SORT
  108.     LR    I,K           NO, GO INCR GOOD DIGIT
  109.     B     INCDI
  110. CHKLAST  EQU   *
  111.     IC    R1,D-1(K)
  112.     CLR   K,R1          IS LAST DIGIT BAD
  113.     BNE   SORTOK        YES, SORT DONE
  114.     LR    I,NM1         NO,  GO INCR D(N-1)
  115.     B     INCDI
  116. SORTOK   EQU   *
  117.     AR    BADCOMB,ONE   COUNT BAD COMBINATION
  118.     LR    I,NM1         GO INCR D(N-1)
  119.     B     INCDI
  120. NOTFOUND EQU   *
  121.     BCTR  I,0           DECREMENT I
  122.     IC    R1,D-1(I)
  123.     LTR   R1,R1         IF NOT OVERFLOW
  124.     BNE   INCDI         THEN GO INCREMENT NEW D(I)
  125.     BR    LINK          ELSE EXIT WITH BAD COMBINATION COUNT
  126.     TITLE 'CALCE - CALCULATE N! AND E FOR GIVEN N'
  127. CALCE    EQU   *               CALCULATE AND FORMAT RESULTS
  128.     CVD   N,PWORK
  129.     MVC   DNN,DNMASK
  130.     ED    DNN,PWORK+6      N
  131.     LR    R1,N
  132.     LR    R2,N
  133.     BCTR  R2,0
  134. NFAC     EQU   *
  135.     MR    R0,R2           GENERATE N!
  136.     BCT   R2,NFAC
  137.     CVD   R1,PWORK
  138.     MVC   DT,DTMASK
  139.     ED    DT,PWORK+4      N!
  140.     ZAP   PT,PWORK
  141.     CVD   BADCOMB,PWORK
  142.     MVC   DB,DBMASK
  143.     ED    DB,PWORK+4      BAD COMBINATIONS
  144.     MP    PT,=P'100000000'
  145.     DP    PT,PWORK+4(4)
  146.     MVC   DE,DEMASK
  147.     ED    DE,PT+7         E
  148.     BR    LINK
  149. *
  150. *  REGISTER ASSIGNMENTS
  151. *
  152. R0       EQU   0   WORK
  153. R1       EQU   1   WORK
  154. R2       EQU   2   WORK
  155. N        EQU   3   NUMBER OF HATS
  156. BADCOMB  EQU   4   BAD COMBINATION COUNTER
  157. I        EQU   5   INDEX FOR DIGITS D(I) AND DP(I)
  158. J        EQU   6   INDEX FOR DIGITS D(J) AND DP(J)
  159. K        EQU   7   INDEX FOR DIGITS D(K) AND DP(K)
  160. ONE      EQU   10  FREQUENTLY USED CONSTANT
  161. NM1      EQU   11  FREQUENTLY USED CONSTANT N-1
  162. BASE     EQU   12  BASE
  163. LINK     EQU   14  LINK
  164. ENTRY    EQU   15  ENTRY
  165. *
  166. *        PC/370 SYSTEM SVC'S
  167. *
  168. WTO      EQU   209  WRITE TO OPERATOR (R2 = ADDRESS OF TEXT FOLLOWED BY $)
  169. EXIT     EQU   0    RETURN TO MSDOS
  170. *
  171. *        DATA AREAS
  172. *
  173. MAXN     EQU   7     MAX NUMBER OF COMBINATIONS (7 TAKES 40 SECONDS ON PC)
  174. DINIT    DC    (MAXN)AL1(*-DINIT+1)   COMBINATION REGISTER WITH DIGITS
  175. DPINIT   DC    (MAXN)AL1(*-DPINIT+1)   POSITION OF VALUE IN D(I)
  176.     DC    C'*** D REG ***'
  177.     DC    X'00'           FORCE OVERFLOW ON CARRY OUT
  178. D        DC    XL(MAXN)'00'    BAD COMBINATION REGISTER
  179.     DC    C'*** DP REG ***'
  180. DP       DC    XL(MAXN)'00'    DIGIT POSITION INDEX REGISER
  181. PWORK    DC    D'0'            WORK AREA FOR CVD
  182. PT       DC    PL16'0'         WORK AREA TO CALC TOTCOMB/BADCOMP
  183. TIME     DC    F'0'
  184. MSGLINE  EQU   *
  185.     DC    C' N='
  186. DNN      DC    C' ZZZ',C'  N!='
  187. DT       DC    C' Z,ZZZ,ZZZ',C'  BAD='
  188. DB       DC    C' Z,ZZZ,ZZZ',C'  E='
  189. DE       DC    C' 9.99999999',C'  SEC='
  190. DS       DC    C' ZZ,ZZZ',C'$'
  191. DNMASK   DC    X'40202020'
  192. DTMASK   DC    X'4020',C',',X'202020',C',',X'202020'
  193. DBMASK   DC    X'4020',C',',X'202020',C',',X'202020'
  194. DEMASK   DC    X'4021',C'.',8X'21'
  195. DSMASK   DC    X'402020',C',',X'202121'
  196.     END   HATGIRL2
  197.